home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / share / mc / extfs / deb < prev    next >
Text File  |  2009-10-25  |  5KB  |  201 lines
  1. #! /usr/bin/perl
  2. #
  3. # Written by Fernando Alegre <alegre@debian.org> 1996
  4. #
  5. # Applied patch by Dimitri Maziuk <emaziuk@curtin.edu.au> 1997
  6. #         (to handle new tar format)
  7. #
  8. # Modified by Fernando Alegre <alegre@debian.org> 1997
  9. #         (to handle both new and old tar formats)
  10. #
  11. # Modified by Patrik Rak <prak@post.cz> 1998
  12. #         (add by Michael Bramer Debian-mc-maintainer <grisu@debian.org>)
  13. #         (to allow access to package control files)
  14. #
  15. # Modified by Martin Bialasinski <martinb@debian.org> 1999
  16. #         (deal with change in tar format)
  17. #
  18. #
  19. # Copyright (C) 1997 Free Software Foundation
  20. #
  21.  
  22. sub quote {
  23.     $_ = shift(@_);
  24.     s/([^\w\/.+-])/\\$1/g;
  25.     return($_);
  26. }
  27.  
  28. sub mcdebfs_list
  29. {
  30. #
  31. #    CAVEAT: Hard links are listed as if they were symlinks
  32. #        Empty directories do not appear at all
  33. #
  34.     local($archivename)=@_;
  35.     local $qarchivename = quote($archivename);
  36.     chop($date=`LC_ALL=C date "+%b %d %H:%M"`);
  37.     chop($info_size=`LC_ALL=C dpkg -I $qarchivename | wc -c`);
  38.     $install_size=length($pressinstall);
  39.  
  40.     print "dr-xr-xr-x   1 root     root     0 $date CONTENTS\n";
  41.     print "dr-xr-xr-x   1 root     root     0 $date DEBIAN\n";
  42.     print "-r--r--r--   1 root     root     $info_size $date INFO\n";
  43.     print "-r-xr--r--   1 root     root     $install_size $date INSTALL\n";
  44.  
  45.     if ( open(PIPEIN, "dpkg-deb -c $qarchivename |") )
  46.     {
  47.         while(<PIPEIN>)
  48.         {
  49.             split;
  50.  
  51.             $perm=$_[0]; $owgr=$_[1]; $size=$_[2];
  52.             if($_[3] =~ /^\d\d\d\d\-/) { # New tar format
  53.                 
  54.                 ($year,$mon,$day) = split(/-/,$_[3]);
  55.                 $month = ("Gee","Jan","Feb","Mar","Apr","May","Jun",
  56.                           "Jul","Aug","Sep","Oct","Nov","Dec")[$mon] || "Gee";
  57.                 $time=$_[4];
  58.                 $pathindex=5;
  59.             }
  60.             else {
  61.                 $mstring='GeeJanFebMarAprMayJunJulAugSepOctNovDec';
  62.                 $month=$_[3];
  63.                 $mon=index($mstring,$month) / 3;
  64.                 $day=$_[4];
  65.                 $time=$_[5];
  66.                 $year=$_[6];
  67.                 $pathindex=7;
  68.             }
  69.             
  70.             $path=$_[$pathindex++];
  71.             $arrow=$_[$pathindex++];
  72.             $link=$_[$pathindex++];
  73.             $link2=$_[$pathindex++];
  74.  
  75.             $owgr=~s!/! !;
  76.             if($arrow eq 'link')
  77.             {
  78. # report hard links as soft links
  79.                 $arrow='->'; $link="/$link2"; 
  80.                 substr($perm, 0, 1) = "l";
  81.             }
  82.             if($arrow ne '')
  83.             {
  84.                 $arrow=' ' . $arrow;
  85.                 $link= ' ' . $link;
  86.             }
  87.             $now=`date "+%Y %m"`;
  88.             ($thisyear, $thismon) = split(/ /, $now);
  89.             # show time for files younger than 6 months
  90.             # but not for files with dates in the future
  91.             if ($year * 12 + $mon > $thisyear * 12 + $thismon - 6 &&
  92.                 $year * 12 + $mon <= $thisyear * 12 + $thismon) {
  93.                 print "$perm 1 $owgr $size $month $day $time CONTENTS/$path$arrow$link\n";
  94.             } else {
  95.                 print "$perm 1 $owgr $size $month $day $year CONTENTS/$path$arrow$link\n";
  96.             }
  97.         }
  98.     }
  99.         if ( open(PIPEIN, "LC_ALL=C dpkg-deb -I $qarchivename |") )
  100.         {
  101.                while(<PIPEIN>)
  102.                {
  103.                        split;
  104.                        $size=$_[0];
  105.                        last if $size =~ /:/;
  106.                        next if $size !~ /\d+/;
  107.                        if($_[4] eq '*')
  108.                        {
  109.                            $perm='-r-xr-xr-x';
  110.                            $name=$_[5];
  111.                        }
  112.                        else
  113.                        {
  114.                            $perm='-r--r--r--';
  115.                            $name=$_[4];
  116.                        }
  117.                        print "$perm 1 root root $size $date DEBIAN/$name\n";
  118.                }
  119.         }
  120. }
  121.  
  122. sub mcdebfs_copyout
  123. {
  124.     local($archive,$filename,$destfile)=@_;
  125.     local $qarchive = quote($archive);
  126.     local $qfilename = quote($filename);
  127.     local $qdestfile = quote($destfile);
  128.  
  129.     if($filename eq "INFO")
  130.     {
  131.         system("dpkg-deb -I $qarchive > $qdestfile");
  132.         }
  133.         elsif($filename =~ /^DEBIAN/)
  134.         {
  135.                $qfilename=~s!^DEBIAN/!!;
  136.                system("dpkg-deb -I $qarchive $qfilename > $qdestfile");
  137.     }
  138.     elsif($filename eq "INSTALL")
  139.     {
  140.         if ( open(FILEOUT,">$destfile") )
  141.         {
  142.             print FILEOUT $pressinstall;
  143.             close FILEOUT;
  144.             system("chmod a+x $qdestfile");
  145.         }
  146.     }
  147.     else
  148.     {
  149.     # files can be prepended with ./ or not, depending on the version of tar
  150.         $qfilename=~s!^CONTENTS/!!;
  151.         system("dpkg-deb --fsys-tarfile $qarchive | tar xOf - $qfilename ./$qfilename > $qdestfile 2>/dev/null");
  152.     }
  153. }
  154.  
  155. sub mcdebfs_run
  156. {
  157.     local($archive,$filename)=@_;
  158.     local $qarchive = quote($archive);
  159.     if($filename eq "INSTALL")
  160.     {
  161.         print "Installing $archive\n";
  162.         system("dpkg -i $qarchive");
  163.     }
  164.     else
  165.     {
  166.         use File::Temp qw(mkdtemp);
  167.         my $template = "/tmp/mcdebfs.run.XXXXXX";
  168.         $template="$ENV{MC_TMPDIR}/mcdebfs.XXXXXX" if ($ENV{MC_TMPDIR});
  169.         $tmpdir = mkdtemp($template);
  170.         $tmpcmd="$tmpdir/run";
  171.         &mcdebfs_copyout($archive, $filename, $tmpcmd);
  172.         system("chmod u+x $tmpcmd");
  173.         system($tmpcmd);
  174.         unlink($tmpcmd);
  175.         rmdir($tmpdir);
  176.     }
  177. }
  178.  
  179. $pressinstall=<<EOInstall;
  180.  
  181.                               WARNING
  182.      Don\'t use this method if you are not willing to reinstall everything...
  183.  
  184. This is not a real file. It is a way to install the package you are browsing.
  185.  
  186. To install this package go back to the panel and press Enter on this file.
  187.  
  188. In Debian systems, a package is automatically upgraded when you install a new
  189. version of it. There is no special upgrade option. Install always works.
  190.  
  191. EOInstall
  192.  
  193. umask 077;
  194.  
  195. if($ARGV[0] eq "list") { shift; &mcdebfs_list(@ARGV); exit 0; }
  196. elsif($ARGV[0] eq "copyout") { shift; &mcdebfs_copyout(@ARGV); exit 0; }
  197. elsif($ARGV[0] eq "run") { shift; &mcdebfs_run(@ARGV); exit 0; }
  198.  
  199. exit 1;
  200.  
  201.